home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / USES.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  4KB  |  160 lines
  1. PROGRAM UsesProg;
  2.  
  3. {$M 20000,0,50000}
  4.  
  5. Uses DOS, PbMISC, PbDATA, PbOBJS, PbOUT0, PbPARMS;
  6.  
  7. {
  8. Description : Examines programs and units USES statements
  9.  
  10. Author      : Howard Richoux
  11. Date        : 2/91
  12. Last revised: 12/25/93
  13.                2/18/94 2.05 new libraries
  14. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  15. Status      : Placed in the Public Domain by HNR Software 1/29/94
  16. Published in: none
  17.  
  18.  Program to scan a group of .pas files and list out the USES statements.
  19.  Alternative mode is to pass the name of a unit on the param line and
  20.  the program will scan the files, listing the ones which use that unit.  The
  21.  match will be for the length of the param you enter, so a group of
  22.  units which all start the same way can be checked at once.
  23. }
  24.  
  25. var S            : string;
  26. var fname        : string[60];
  27.     testunit     : string[8];
  28.     firstmsg     : boolean;
  29.  
  30.  
  31. {*****************************************************************}
  32.  
  33. Procedure CheckUses( testunit : string; var s1 : string);
  34. var i,l    : integer;     { makes s1 := '' if testunit not found }
  35.     s,s2   : string;
  36.     ok     : boolean;
  37.      begin
  38.      {writeln('Checkuses  [',testunit,'] [',s1,']');}
  39.      l := length(testunit);
  40.      if l = 0 then exit;
  41.      if length(s1) = 0 then exit;
  42.      s := s1;
  43.      ok := false;
  44.      while length(s) > 0 do
  45.           begin
  46.           s2 := getstring(s);
  47.           if testunit = UpCaseStr(leftstr(s2,l)) then ok := true;
  48.           end;
  49.      if not ok then s1 := '';
  50.      end;
  51.  
  52.  
  53. Procedure ListFile(fname : string);
  54. var line,s : string;
  55.     s1     : string;
  56.     done,found,ok : boolean;
  57.     i             : integer;
  58.     tx            : TFILE_object;
  59.     begin
  60.    { writeln('ListFile  [',fname,']');}
  61.     s1 := '';
  62.     done := false;
  63.     found := false;
  64.     tx.init(fname,false);
  65.     while tx.fetchnext(line) and not done do
  66.         begin
  67.         s := UpCaseStr(line);
  68.         trim(s);
  69.         if copy(s,1,4) = 'USES' then
  70.              begin
  71.              delete(line,1,4);
  72.              found := true;
  73.              end;
  74.         if found then
  75.              begin
  76.              s1 := s1 + line;
  77.              removeblanks(s1);
  78.              ok := removebracketcomments(s1,'{','}');
  79.              i := pos(';',line);
  80.              if i > 0 then done := true;
  81.              end;
  82.         end;
  83.     CheckUses(testunit,s1);
  84.     if length(s1) > 0 then
  85.          begin
  86.          if firstmsg and (testunit <> '') then
  87.               begin
  88.               firstmsg := false;
  89.               OUT(' The following files use: ['+testunit+']');
  90.               OUT(' ');
  91.               end;
  92.          OUT(leftstr(fname,12)+' USES '+s1);
  93.          end
  94.     else if testunit = '' then OUT(leftstr(fname,12)+' USES none');
  95.     tx.done;
  96.     end;
  97.  
  98.  
  99.  
  100. Procedure ListFiles(fn : string);
  101. var SR :searchrec;
  102.     i  : integer;
  103.     fname : string;
  104.      begin
  105.      writeln('');
  106.     { writeln('ListFiles [',fn,']');}
  107.      fname := fn;
  108.      FindFirst(fname,anyfile,SR);
  109.      while dosError = 0 do
  110.           begin
  111.           fname := SR.name;
  112.           ListFile(fname);
  113.           FindNext(SR);
  114.           end;
  115.      end;
  116.  
  117.  
  118. Procedure init;
  119.      begin
  120.      testunit := '';
  121.      firstmsg := true;
  122.  
  123.      StandardOUTInit;
  124.      OUTSetCompressed;
  125.      getdir(0,fname);
  126.      fname := addbackslash(fname) + '*.pas';
  127.      writeln('');
  128.      end;
  129.  
  130.  
  131. (*  Main program *)
  132.      BEGIN
  133.      pProgID := 'USES 2.05';
  134.      init;
  135.      writeln(pProgID,' - USES Checker');
  136.  
  137.      if paramcount > 0 then      { want to check for specific unit }
  138.           begin
  139.           writeln(' scanning: ',fname);
  140.           if paramstr(1) = '*' then
  141.                begin
  142.                ListFiles(fname);
  143.                end
  144.           else begin
  145.                testunit := UpCaseStr(paramstr(1));
  146.                writeln(' Checking for: ',qt(testunit));
  147.                ListFiles(fname);
  148.                end;
  149.           if firstmsg then
  150.                begin
  151.                if testunit <> '' then
  152.                     writeln(' No files used [',testunit,']');
  153.                end;
  154.           end
  155.      else ShowDocFile;
  156.      OUTdone;
  157.      end.
  158.  
  159.  
  160.